Programmer Power Tools/Programmer Power Tools.iso/printer/prtfile.arc/PRTF.PAS

Pascal/Delphi Source File | 1987-11-12 | 10.3 KB | 301 lines

program prtf ;
  { Prints a text file on the list device, formatted with various
    user-supplied options.  Turbo Pascal, MS/PC-DOS.  Public Domain.

    Bill Meacham
    1004 Elm Street, Austin, Tx  78703

    This revision picks up the DOS date and time and puts it into the
    header.  Does NOT ask for header and pages to print -- prints all
    with no header.  Single space only.

    You can specify up to maxparms (see const below) file names on the
    command line and it will print them all.  If you don't specify any
    on the command line, it will ask for one.

    To quit, enter a blank file name when it asks you for one.
    To quit prematurely, type any letter.  It will ask if you want to quit.

    Last modified: 11/12/87 }

{$V-}  { Turn off strict type-checking for strings }

label            99 ;               { for premature exit }

const
    formfeed   = ^L ;
    bell       = ^G ;
    linelength = 255 ;              { max length of text file lines }
    maxparms   = 10 ;               { max number of files on command line }

type
    st_typ  = string[linelength] ;
    regpack = record case integer of
                1: (AX,BX,CX,DX,BP,DI,SI,DS,ES,Flags : integer) ;
                2: (AL,AH,BL,BH,CL,CH,DL,DH : byte)
               end ;
    str14   = string[14] ;
    str66   = string[66] ;
    parmarray = array[1..maxparms] of str66 ;

var
    registers                  : regpack ;
    parms                      : parmarray ;   { command line parameters }
    line, header               : st_typ ;      { print lines }
    blank_line                 : st_typ ;      { to add indentation }
    page_num, line_cnt,
    p_count, i, n, p           : integer ;     { counters }
    indent, spacing, max_lines : integer ;     { user-supplied }
    first_page, last_page      : integer ;     { user_supplied }
    fname                      : string[66] ;  { file name }
    ipt_file                   : text ;        { input file }
    ok                         : boolean ;     { whether file exists }
    reply                      : char ;        { to get user response }
    quit                       : boolean ;     { to flag when last page printed }

{ ----------------------------------------------------------------- }

function date_and_time : str14 ;
  { get DOS system date and time }

var
  year,
  month,day,
  hour,min  : string[2];

begin
  with registers do
    begin
      AX := $2A00 ;
      msdos(registers) ;
      str(CX-1900,year) ;
      str(DH,month) ;
      str(DL,day) ;
      AX := $2C00 ;
      msdos (registers) ;
      str(CH:2,hour) ;
      str(CL:2,min) ;
    end ;
  if  min[1] = ' ' then  min[1] := '0' ;
  if  (hour[1] = ' ')
  and (hour[2] = '0') then
      hour := '00' ;
  date_and_time := concat (month,'/',day,'/',year,' ',hour,':',min) ;
end ; { function getdate }

{ ----------------------------------------------------------------- }

procedure print_page_header ;
  { prints header line at top of each page -- revised, 11/17/84 }
    var
        i : integer ;
    begin
        page_num := page_num + 1 ;
        if page_num > last_page then
            quit := true
        else
          begin
            if page_num >= first_page then
              begin
                if page_num > first_page then
                    write (lst, formfeed) ;
                writeln (lst) ;
                write (lst, header) ;
                writeln (lst, page_num) ;
                writeln (lst) ;
                for i := 1 to spacing do
                    writeln (lst)
              end ;
            line_cnt := 3 + spacing
          end
    end ;  { proc print_page_header }

{ ----------------------------------------------------------------- }

procedure print (line : st_typ ; num_newlines : integer) ;
  { prints a line and the number of newlines indicated }
    var
        i : integer ;
    begin
        if line_cnt > max_lines then
            print_page_header ;
        if  (page_num >= first_page)
        and (page_num <= last_page) then
          begin
            write (lst,line) ;
            for i := 1 to num_newlines do
                writeln (lst)
          end ;
        line_cnt := line_cnt + num_newlines
    end ;  { proc print }

{ ----------------------------------------------------------------- }

procedure add_blanks (var st : st_typ ; num_blanks : integer) ;
  { appends the number of blanks indicated to the string }
    var
        i : integer ;
    begin
        for i := 1 to num_blanks do
            st := concat (st,' ')
    end ;  { proc add_blanks }

{ ----------------------------------------------------------------- }

function adjust_line (line : st_typ) : st_typ ;
  { Converts tabs to spaces and adds indentation by moving characters
    one by one from the input string to a work string.  If it encounters
    a tab character it expands the tab to the proper number of spaces.
    Finally, the indentation string is inserted in front of all the
    characters and the function returns the work string. }

    const
        tab = ^I ;
    var
        i            : integer ;    { loop counter }
        next_char    : integer ;    { where the next character goes
                                      in the work string }
        work_str     : st_typ ;     { work string to build adjusted line }
    begin
        work_str := '' ;
        next_char := 1 ;
        for i := 1 to length(line) do
            if not (line[i] = tab) then
              begin
                work_str := concat(work_str,line[i]) ;
                next_char := next_char + 1
              end
            else         { character is a tab -- convert to spaces }
                repeat
                    work_str := concat(work_str,' ') ;
                    next_char := next_char + 1
                until (next_char > 8) and ((next_char mod 8) = 1) ;
        insert (blank_line,work_str,1) ;
        adjust_line := work_str
    end ;  { --- proc adjust_line --- }

{ ----------------------------------------------------------------- }

begin { --- MAIN --- }
    writeln ;
    writeln ('This prints one or more text files, paginated with DOS date & time.') ;
    writeln ('Defaults are no indent, 58 lines per page.') ;
    writeln ('If not on command line, specify file name last; <cr> on file name to cancel.') ;
    writeln ;

    for i := 1 to maxparms do                    { get file names from }
        parms[i] := '' ;                         { command line }
    p_count := paramcount ;
    if p_count > maxparms then p_count := maxparms ;
    for i := 1 to p_count do
        parms[i] := paramstr(i) ;
    p := 1 ;

    indent := 0 ;                                { get indentation }
    write   ('Number of spaces to indent? ') ;
    readln  (indent) ;
    if indent < 0 then indent := 0 ;
    blank_line := '' ;
    if not (indent = 0 ) then
        for i := 1 to indent do
            blank_line := concat (' ',blank_line) ;

    spacing    := 1 ;                            { line spacing }
    first_page := 1 ;
    last_page  := maxint ;

    max_lines := 0 ;                             { get page length }
    write   ('Max lines per page? ') ;
    readln  (max_lines) ;
    if max_lines < 1 then
        max_lines := 58 ;

    while true do                                { endless loop }
      begin
        if p_count = 0 then
            fname := ''
        else if (p > p_count) then
          begin
            writeln ('Done!',bell) ;
            halt                                 { --- Exit loop here --- }
          end
        else { p <= p_count }                    { get file name }
          begin
            fname := parms[p] ;
            p := succ(p)
          end ;
        repeat
            if fname = '' then
              begin
                write   ('File name? ') ;
                readln  (fname) ;
              end ;
            if fname = '' then
                halt                             { --- Exit loop here --- }
            else
              begin
                for n := 1 to length(fname) do
                    fname[n] := upcase(fname[n]) ;
                assign (ipt_file,fname) ;
                {$i-}
                reset (ipt_file) ;
                {$i+}
                ok := (ioresult = 0) ;
                if not ok then
                  begin
                    writeln (bell,'File ',fname,' not found.') ;
                    fname := ''
                  end
              end
        until ok ;

        header := blank_line ;                   { build header line }
        header := concat(header,fname) ;
        if length(header) < 57 then
            add_blanks (header, 57 - length(header))
        else
            add_blanks (header,2) ;
        header := concat (header,date_and_time,' Page ') ;
        page_num := 0 ;
        line_cnt := maxint ;                     { force first page header }

        quit := false ;
        writeln ('Printing ',fname) ;
        while not (eof(ipt_file)) do             { print the text file }
          begin
            readln (ipt_file,line) ;
            if not (indent = 0) then             { add identation }
                line := adjust_line (line) ;
            repeat
                n := pos(formfeed,line) ;        { handle embedded formfeeds }
                if not (n = 0) then
                  begin
                    print (copy(line,1,n-1),spacing) ;
                    print_page_header ;
                    if quit then
                        goto 99 ;
                    delete (line,1,n) ;
                    for i := 1 to indent do
                        line := concat(' ',line) ;
                  end
            until n = 0 ;
            print  (line,spacing) ;

            if keypressed then                   { check for premature exit }
              begin
                writeln ;
                write  ('+++ Quit now? (Y/N): ') ;
                readln (reply) ;
                if upcase(reply) = 'Y' then
                    goto 99
              end ;
            if quit then
                goto 99
          end ; { while not EOF }

99:     write (lst,formfeed) ;
        if p_count = 0 then
            writeln ('Done!',bell)
      end  { while true, endless loop }
end.